home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1995-04-11 | 3.3 KB | 114 lines | [TEXT/.Ob4] |
- Syntax10.Scn.Fnt
- MODULE Kepler2; (* J. Templ, 5.11.90/01.07.93 *)
- IMPORT
- KeplerGraphs, KeplerFrames, Math, Oberon, Texts, Files, Fonts, Display;
- TYPE
- Fraction* = POINTER TO FractionDesc;
- FractionDesc* = RECORD
- (KeplerGraphs.PlanetDesc)
- cnt*, dn*: LONGINT
- END ;
- XY* = POINTER TO XYDesc;
- XYDesc* = RECORD
- (KeplerGraphs.PlanetDesc)
- END ;
- Offset* = POINTER TO OffsetDesc;
- OffsetDesc* = RECORD
- (KeplerGraphs.PlanetDesc)
- dx*, dy*: INTEGER;
- END ;
- (* ------------------------------- Fraction ------------------------------- *)
- PROCEDURE (self: Fraction) Calc*;
- VAR x0, x1, y0, y1: INTEGER;
- BEGIN
- x0 := self.c.p[0].x; x1 := self.c.p[1].x; y0 := self.c.p[0].y; y1 := self.c.p[1].y;
- self.x := SHORT(x0 + (x1 - x0) * self.cnt DIV self.dn);
- self.y := SHORT(y0 + (y1 - y0) * self.cnt DIV self.dn)
- END Calc;
- PROCEDURE (self: Fraction) Write* (VAR R: Files.Rider);
- BEGIN
- Files.WriteNum(R, self.cnt);
- Files.WriteNum(R, self.dn);
- self.Write^(R)
- END Write;
- PROCEDURE (self: Fraction) Read* (VAR R: Files.Rider);
- BEGIN
- Files.ReadNum(R, self.cnt);
- Files.ReadNum(R, self.dn);
- self.Read^(R)
- END Read;
- PROCEDURE NewFractions*;
- VAR f: Fraction; c: KeplerGraphs.Constellation; S: Texts.Scanner;
- p0, p1: KeplerGraphs.Star; i: LONGINT;
- BEGIN
- IF KeplerFrames.nofpts >= 2 THEN
- Texts.OpenScanner(S,Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
- IF (S.class = Texts.Int) & (S.i > 0 ) THEN
- KeplerFrames.ConsumePoint(p0);
- KeplerFrames.ConsumePoint(p1);
- i := S.i - 1;
- WHILE i > 0 DO
- NEW(f); NEW(c); c.nofpts := 2; f.c := c;
- c.p[0] := p0; c.p[1] := p1; INC(p0.refcnt); INC(p1.refcnt);
- f.cnt := SHORT(i); f.dn := SHORT(S.i); f.Calc;
- KeplerFrames.Focus.Append(f);
- KeplerFrames.Focus.FlipSelection(f);
- DEC(i)
- END ;
- DEC(p0.refcnt); DEC(p1.refcnt)
- END
- END
- END NewFractions;
- (* ------------------------------- XY ------------------------------- *)
- PROCEDURE (self: XY) Calc*;
- BEGIN
- self.x := self.c.p[0].x;
- self.y := self.c.p[1].y
- END Calc;
- PROCEDURE NewXY*;
- VAR cp: XY; c: KeplerGraphs.Constellation;
- BEGIN
- IF KeplerFrames.nofpts >= 2 THEN
- NEW(cp); NEW(c); c.nofpts := 2;
- KeplerFrames.ConsumePoint(c.p[0]);
- KeplerFrames.ConsumePoint(c.p[1]);
- cp.c := c; cp.Calc;
- KeplerFrames.Focus.Append(cp);
- KeplerFrames.Focus.FlipSelection(cp)
- END
- END NewXY;
- (* ------------------------------- Offset ------------------------------- *)
- PROCEDURE (self: Offset) Calc*;
- BEGIN
- self.x := self.c.p[0].x + self.dx;
- self.y := self.c.p[0].y + self.dy
- END Calc;
- PROCEDURE (self: Offset) Read* (VAR R: Files.Rider);
- VAR t: LONGINT;
- BEGIN
- Files.ReadNum(R, t); self.dx := SHORT(t);
- Files.ReadNum(R, t); self.dy := SHORT(t);
- self.Read^(R)
- END Read;
- PROCEDURE (self: Offset) Write* (VAR R: Files.Rider);
- BEGIN
- Files.WriteNum(R, self.dx);
- Files.WriteNum(R, self.dy);
- self.Write^(R)
- END Write;
- PROCEDURE NewOffset*;
- VAR p0, p1: KeplerGraphs.Star;
- offset: Offset;
- BEGIN
- IF KeplerFrames.nofpts > 1 THEN
- KeplerFrames.ConsumePoint(p0);
- KeplerFrames.GetPoint(p1);
- NEW(offset); NEW(offset.c);
- offset.c.p[0] := p0; offset.c.nofpts := 1;
- offset.dx := p1.x - p0.x; offset.dy := p1.y - p0.y; offset.Calc;
- KeplerFrames.Focus.Append(offset);
- KeplerFrames.Focus.FlipSelection(offset)
- END
- END NewOffset;
- END Kepler2.
-